Mac Mania 2/MacMania 2.toast/Demo's/Tools&Utilities/Programming/MacStarter Pascal 1.0/xWindows definition files/TextPrint.p

Text File | 1993-09-14 | 6.7 KB | 261 lines | [TEXT/PJMM]

unit TextPrint;

{  This unit defines simple procedures for printing text.  To use it you should: }
{                1) Include a Page Setup command in your File menu, and call DoPageSetup }
{                     in response to it. }
{                2) Add the file PrintTraps.p (from the Interfaces folder in THINK Pascal) }
{                    to your project. }
{                3) Set PrintDataRecord := NIL in your application initialization procedure (so }
{                    that the procedures in this unit will know that it needs to be initialized }
{                    when they are first called. }

interface

uses
    PrintTraps;

var
    PrintDataRecord: THPrint;

procedure DoPageSetup;

procedure SimplePrintText (theText: CharsHandle);

procedure PrintText (theText: CharsHandle;
                            textLength: integer;
                            header: string;
                            theFont, theFontSize: integer;
                            inchesWide: real);


implementation

var
    printDlg: DialogRecord;
    printDlgPtr: dialogPtr;

procedure TellUser (message: string);
    var
        bttn: integer;
    begin
        ParamText(message, '', '', '');
        bttn := NoteAlert(129, nil);
        if bttn = -1 then
            Sysbeep(5);
    end;

procedure initPrint (var good: boolean);
    begin
        PrOpen;
        if PrError <> noErr then begin
                TellUser('Unable to open printer driver.  (Have you used theChooser to select a printer?)');
                good := false;
            end;
        if PrintDataRecord <> nil then
            good := true
        else begin
                PrintDataRecord := THPrint(NewHandle(SizeOf(TPrint)));
                if MemError <> noErr then begin
                        TellUser('You do not have enough memory available for printing.');
                        good := false
                    end
                else begin
                        PrintDefault(PrintDataRecord);
                        good := true
                    end;
            end;
    end;

procedure DoPageSetup;
    var
        good: boolean;
    begin
        initPrint(good);
        if good then
            good := PrStlDialog(PrintDataRecord);
        PRClose;
    end;


procedure SimplePrintText (theText: CharsHandle);
    begin
        PrintText(theText, GetHandleSize(Handle(theText)), '', geneva, 12, 0);
    end;


procedure PrintText (theText: CharsHandle;
                                textLength: integer;
                                header: string;
                                theFont, theFontSize: integer;
                                inchesWide: real);
    var
        good: boolean;
        savePort: GrafPtr;
        currentLine, currentWord: string;
        currentPageHeight: integer;
        i: integer;
        hRes, vRes: integer;
        lineHeight: integer;
        pageWidth, pageHeight: integer;
        margin: integer;
        prPort: TPPrPort;
        status: TPrStatus;
        fInfo: FontInfo;
        pageNo: integer;
        left, right: integer;
        startingPage: boolean;
        BlankCt: integer;
    procedure StartPage;
        var
            i: integer;
            str: string;
            time: DateTimeRec;
            shoveRight: boolean;
        begin
            if currentPageHeight <> -2 then begin
                    PrOpenPage(prPort, nil);
                    TextFont(theFont);
                    TextSize(theFontSize);
                end;
            PageNo := pageNo + 1;
            if header = '' then
                CurrentPageHeight := 0
            else begin
                    GetTime(time);
                    i := 1;
                    str := '';
                    shoveRight := false;
                    MoveTo(left, finfo.ascent);
                    while i <= length(header) do begin
                            if (header[i] <> '\') | (i = length(header)) then
                                str := Concat(str, header[i])
                            else begin
                                    i := i + 1;
                                    if header[i] = 'p' then
                                        str := StringOf(str, pageNo : 1)
                                    else if header[i] = 'd' then
                                        str := stringOf(str, time.month : 1, '/', time.day : 1, '/', time.year mod 100 : 1)
                                    else if header[i] = 't' then
                                        str := stringOf(str, time.hour : 1, ':', time.minute : 1, ':', time.second : 1)
                                    else if header[i] = 'r' then begin
                                            if str <> '' then begin
                                                    TextFace([bold]);
                                                    DrawString(str);
                                                    str := '';
                                                end;
                                            shoveRight := true;
                                        end
                                    else
                                        Str := Concat(str, header[i])
                                end;
                            i := i + 1;
                        end;
                    TextFace([bold]);
                    if shoveRight then
                        MoveTo(right - StringWidth(str), fInfo.ascent)
                    else
                        MoveTo(left, finfo.ascent);
                    DrawString(str);
                    TextFace([]);
                    CurrentPageHeight := lineHeight * 2;
                end;
            startingPage := true;
        end;
    procedure DumpLine;
        begin
            if (currentLine <> '') | not startingPage then begin
                    MoveTo(left, CurrentPageHeight + fInfo.ascent);
                    DrawString(currentLine);
                    CurrentPageHeight := CurrentPageHeight + lineHeight;
                    currentLine := '';
                    if currentpageHeight + FInfo.ascent > pageHeight then begin
                            PRClosePage(prPort);
                            CurrentPageHeight := -1;
                        end;
                end;
        end;
    procedure DumpWord;
        var
            j: integer;
        begin
            if StringWidth(currentLine) + StringWidth(currentWord) > margin then
                DumpLine;
            currentLine := concat(currentLine, currentWord);
            currentWord := '';
            if (currentLine <> '') | (BlankCt > 2) then
                for j := 1 to BlankCt do
                    currentLine := Concat(currentLine, ' ');
            BlankCt := 0;
        end;
    procedure PutChar (ch: char);
        begin
            if CurrentPageHeight < 0 then
                StartPage
            else
                startingPage := false;
            if (ch = chr(13)) | (ch = chr(3)) then begin
                    if currentWord <> '' then
                        DumpWord;
                    BlankCt := 0;
                    DumpLine;
                end
            else if ch = ' ' then
                BlankCt := BlankCt + 1
            else begin
                    if (BlankCt > 0) | (StringWidth(currentWord) + charWidth(ch) > margin) then
                        DumpWord;
                    currentWord := Concat(currentWord, ch);
                end;
        end;
    begin
        initPrint(good);
        if not good then
            exit(PrintText);
        good := PrJobDialog(printDataRecord);
        if not good then
            EXIT(printText);  { user canceled }
        GetPort(savePort);
        printDlgPtr := GetNewDialog(300, @printDlg, pointer(-1));
        DrawDialog(printDlgPtr);
        prPort := PrOpenDoc(PrintDataRecord, nil, nil);
        PrOpenPage(prPort, nil);
        TextFont(theFont);
        TextSize(theFontSize);
        GetFontInfo(fInfo);
        lineHeight := fInfo.ascent + fInfo.descent + fInfo.leading;
        hRes := printDataRecord^^.prInfo.iHRes;
        vRes := printDataRecord^^.prInfo.iVRes;
        pageHeight := printDataRecord^^.prInfo.rPage.bottom - vRes;  { allow 1/2 inch margins all around }
        pageWidth := printDataRecord^^.prInfo.rPage.right - hRes;
        if inchesWide < 1 then
            margin := pageWidth
        else
            margin := round(inchesWide * hRes);
        if margin > pageWidth then
            margin := pageWidth;
        left := hRes div 2;
        right := left + margin;
        currentLine := '';
        currentWord := '';
        currentPageHeight := -2;  { -2 tells start page not to open a new page }
        PageNo := 0;
        BlankCt := 0;
        for i := 0 to textLength - 1 do
            PutChar(theText^^[i]);
        if CurrentPageHeight <> -1 then begin
                DumpWord;
                DumpLine;
                if CurrentPageHeight <> -1 then
                    PrClosePage(prPort);
            end;
        PrCloseDoc(prPort);
        if (printDataRecord^^.prJob.bJDocLoop = bSpoolLoop) & (PrError = noErr) then begin
                PrPicFile(printDataRecord, nil, nil, nil, status);
            end;
        CloseDialog(printDlgPtr);
        SetPort(savePort);
        PRClose
    end;


end.